home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok20.lha / ComplexLib / txt / FFPComplexLib.mod < prev    next >
Text File  |  1993-08-15  |  20KB  |  476 lines
  1.  
  2. (*********************************************************************
  3.  
  4.     :Program.       FFPComplexLib.mod
  5.     :Author.        Gary Struhlik  
  6.     :Address.    -
  7.     :Phone.      -
  8.     :shortcut.      [gs]
  9.     :Version.       1.0   
  10.     :Date.          08.10.1988
  11.     :Copyright.  PD
  12.     :Language.      Modula-II
  13.     :Translator. M2Amiga
  14.     :Imports.     -
  15.     :UpDate.     -
  16.     :Contents.   Dieses Modul unterstützt das Rechnen mit komplexen Zahlen 
  17.     :Contents.   Es werden die Grundrechenarten und wichtige mathematische
  18.     :Contents.   Funktionen zur Verfügung gestellt, welche in den Bereichen
  19.     :Contents.   Naturwissenschaft und Technik häufig benötigt werden.
  20.     :Remark.     Für den Amiga Modula-2 Klub / Stuttgart
  21.     :Remark.     Am 01.01.1989 mit M2Amiga 3.2d neu kompiliert
  22.  
  23. **********************************************************************)
  24.  
  25. IMPLEMENTATION MODULE FFPComplexLib;  (* für FFP *)
  26.  
  27. FROM SYSTEM IMPORT FFP;
  28. FROM MathTrans IMPORT Sin,Cos,Log,Exp,Atan,Sqrt,Sinh,Cosh;
  29.  
  30. (*-------------------------------------------------------------------------*)
  31. (*                                                                         *)
  32. (*  PROCEDURE: compop                                                      *)
  33. (*                                                                         *)
  34. (*  AUFGABE: Grundrechenarten mit komplexen Zahlen [ +, -, *, / ]          *)
  35. (*                                                                         *)
  36. (*-------------------------------------------------------------------------*)  
  37.  
  38. PROCEDURE compop (VAR Z:FFPCOMPLEX; A:FFPCOMPLEX; OP:CHAR; B:FFPCOMPLEX); 
  39. VAR
  40.        Y : FFP;        (*      Z:=A OP B      *)
  41. BEGIN                    (* mit OP +,-,* oder / *) 
  42.     CASE OP OF
  43.  
  44.     '+' :  (* Addition *)
  45.         Z.RE:=A.RE+B.RE;   
  46.         Z.IM:=A.IM+B.IM
  47.           |
  48.     '-' : (* Subtraktion *)
  49.         Z.RE:=A.RE-B.RE;
  50.         Z.IM:=A.IM-B.IM
  51.           |
  52.     '*' : (* Multiplikation *)
  53.         Z.RE:=A.RE*B.RE-A.IM*B.IM;
  54.         Z.IM:=A.IM*B.RE+A.RE*B.IM
  55.           |
  56.      '/' : (* Division *)
  57.         Y:=B.RE*B.RE+B.IM*B.IM;
  58.         Z.RE:=(A.RE*B.RE+A.IM*B.IM)/Y;
  59.         Z.IM:=(A.IM*B.RE-A.RE*B.IM)/Y
  60.     END (* CASE OP OF *)
  61. END compop;
  62.  
  63. (*-------------------------------------------------------------------------*)
  64. (*                                                                         *)
  65. (* PROCEDURE: conjg                                                        *)
  66. (*                                                                         *)
  67. (* AUFGABE: konjugiert komplexe Zahl                                       *)
  68. (*-------------------------------------------------------------------------*)
  69.  
  70. PROCEDURE conjg (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  71. BEGIN
  72.     Z.RE:=A.RE;   (* Z:=conjg(A) *)
  73.     Z.IM:=-A.IM
  74. END conjg;
  75.  
  76. (*-------------------------------------------------------------------------*)
  77. (*                                                                         *)
  78. (* FUNCTION: cabs                                                          *)
  79. (*                                                                         *)
  80. (* AUFGABE: Betrag der komplexen Zahl                                      *)
  81. (*-------------------------------------------------------------------------*)
  82.  
  83. PROCEDURE cabs (A : FFPCOMPLEX) : FFP; 
  84. BEGIN
  85.     RETURN Sqrt(A.RE*A.RE+A.IM*A.IM)     (* Y:=cabs(A); Y ist reell *)
  86. END cabs;
  87.  
  88. (*-------------------------------------------------------------------------*)
  89. (*                                                                         *)
  90. (* FUNCTION: carg                                                          *)
  91. (*                                                                         *)
  92. (* AUFGABE: Winkel der komplexen Zahl im Bogenmaß                          *)
  93. (*-------------------------------------------------------------------------*)
  94.  
  95. PROCEDURE carg (A : FFPCOMPLEX) : FFP;    
  96. VAR
  97.     X : FFP;          (* Y:=carg(A); Y ist reell *)
  98. BEGIN    
  99.     IF ((A.RE=0.0) AND (A.IM<0.0)) THEN X:=-PI/2.0
  100.        ELSE
  101.           IF ((A.RE=0.0) AND (A.IM>0.0)) THEN X:=PI/2.0
  102.          ELSE IF
  103.             ((A.RE<0.0) AND (A.IM=0.0)) THEN X:=PI
  104.                 ELSE 
  105.                   X:=Atan (A.IM/A.RE);
  106.                IF (A.RE<0.0) AND (A.IM>0.0) THEN
  107.                   X:=PI+X;
  108.                            END;   
  109.                IF (A.RE<0.0) AND (A.IM<0.0) THEN
  110.                   X:=-PI+X
  111.                            END
  112.                     END
  113.               END
  114.         END;                 
  115.     RETURN X
  116. END carg;
  117.  
  118. (*-------------------------------------------------------------------------*)
  119. (*                                                                         *)
  120. (* PROCEDURE: cpol                                                         *)
  121. (*                                                                         *)
  122. (* AUFGABE: Umwandlung komplexer Zahlen von Normalform in Exponentialform  *)
  123. (* Wichtig: Der Winkel wird in Grad ausgegeben !                           *)
  124. (*-------------------------------------------------------------------------*)
  125.  
  126. PROCEDURE cpol (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  127.         (* Hinweis: Z.RE ist der Betrag und Z.IM der Winkel ! *)
  128.     (* Z:=cpol(A) *)
  129. BEGIN    
  130.     Z.RE:=Sqrt(A.RE*A.RE+A.IM*A.IM); (* Betrag der komplexen Zahl *)
  131.     Z.IM:=carg(A)*180.0/PI; (* Winkel in Grad ! *)
  132. END cpol;        
  133.  
  134. (*-------------------------------------------------------------------------*)
  135. (*                                                                         *)
  136. (* PROCEDURE: crec                                                         *)
  137. (*                                                                         *)
  138. (* AUFGABE: Umwandlung komplexer Zahlen von Exponentialform in Normalform  *)
  139. (* Wichtig: Der Winkel muß in Grad übergeben werden !                      *)
  140. (*-------------------------------------------------------------------------*)
  141.  
  142. PROCEDURE crec (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  143. VAR
  144.     X : FFP;  (* Hinweis: A.RE ist der Betrag und A.IM der Winkel ! *)
  145.     (* Z:=crec(A) *)
  146. BEGIN
  147.     X:=PI/180.0*A.IM; (* Umwandlung von Grad in Bogenmaß *)
  148.     Z.RE:=A.RE*Cos(X); (* Realteil *)    
  149.     Z.IM:=A.RE*Sin(X); (* Imaginärteil *)
  150. END crec;
  151.  
  152. (*-------------------------------------------------------------------------*)
  153. (*                                                                         *)
  154. (* PROCEDURE: crcp                                                         *)
  155. (*                                                                         *)
  156. (* AUFGABE: Kehrwert der komplexen Zahl                                    *)
  157. (*-------------------------------------------------------------------------*)
  158.  
  159. PROCEDURE crcp (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  160. VAR
  161.     X : FFP;        (* Z:=crcp(A) *)
  162. BEGIN
  163.     X:=A.RE*A.RE+A.IM*A.IM;
  164.     Z.RE:=A.RE/X; 
  165.     Z.IM:=-A.IM/X
  166. END crcp;
  167.  
  168. (*-------------------------------------------------------------------------*)
  169. (*                                                                         *)
  170. (* PROCEDURE: cexp                                                         *)
  171. (*                                                                         *)
  172. (* AUFGABE: komplexe Exponentialfunktion                                   *)
  173. (*-------------------------------------------------------------------------*)
  174.  
  175. PROCEDURE cexp (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  176. VAR
  177.     X : FFP;  (* Z:=cexp(A) *)
  178. BEGIN
  179.     X:=Exp(A.RE);
  180.     Z.RE:=X*Cos(A.IM);
  181.     Z.IM:=X*Sin(A.IM)
  182. END cexp;
  183.  
  184. (*-------------------------------------------------------------------------*)
  185. (*                                                                         *)
  186. (* PROCEDURE: cln                                                          *)
  187. (*                                                                         *)
  188. (* AUFGABE: komplexer natürlicher Logarithmus                              *)
  189. (*-------------------------------------------------------------------------*)
  190.  
  191. PROCEDURE cln (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  192. BEGIN                                              (* Z:=cln(A) *)
  193.     Z.RE:=(Log (A.RE*A.RE+A.IM*A.IM))/2.0;
  194.     Z.IM:=carg(A)
  195. END cln;
  196.  
  197. (*-------------------------------------------------------------------------*)
  198. (*                                                                         *)
  199. (* PROCEDURE: csqr                                                         *)
  200. (*                                                                         *)
  201. (* AUFGABE: quadrierte komplexe Zahl                                       *)
  202. (*-------------------------------------------------------------------------*)
  203.  
  204. PROCEDURE csqr (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  205. BEGIN                                      (* Z:=csqr(A) *)
  206.     Z.RE:=A.RE*A.RE-A.IM*A.IM;
  207.     Z.IM:=2.0*A.RE*A.IM
  208. END csqr;
  209.  
  210. (*-------------------------------------------------------------------------*)
  211. (*                                                                         *)
  212. (* FUNCTION : root                                                         *)
  213. (*                                                                         *)
  214. (* AUFGABE: n-te reelle Wurzel                                             *)
  215. (*-------------------------------------------------------------------------*)
  216.  
  217. PROCEDURE root (N,X : FFP) : FFP;
  218. BEGIN
  219.     RETURN Exp(Log(X)/N)   (* N-te Wurzel aus X *)
  220. END root;
  221.  
  222. (*-------------------------------------------------------------------------*)
  223. (*                                                                         *)
  224. (* PROCEDURE: csqrt                                                        *)
  225. (*                                                                         *)
  226. (* AUFGABE: komplexe Quadratwurzel (nur Hauptwert ! )                      *)
  227. (*-------------------------------------------------------------------------*)
  228.  
  229. PROCEDURE csqrt (VAR Z:FFPCOMPLEX; A : FFPCOMPLEX); 
  230.         (* Z:=csqrt(A); nur Hauptwert (k=0) *)
  231. VAR
  232.     R,PHI,KONST : FFP;
  233. BEGIN
  234.     R:=Sqrt(cabs(A)); (* Betrag von A *)
  235.     PHI:=carg(A); (* Winkel von A im Bogenmaß *)
  236.     KONST:=PHI/2.0;
  237.     Z.RE:=R*Cos(KONST);
  238.     Z.IM:=R*Sin(KONST)
  239. END csqrt; 
  240.  
  241.  
  242. (*-------------------------------------------------------------------------*)
  243. (*                                                                         *)
  244. (* PROCEDURE: csin                                                         *)
  245. (*                                                                         *)
  246. (* AUFGABE: komplexer Sinus                                                *)
  247. (*-------------------------------------------------------------------------*)
  248.  
  249. PROCEDURE csin (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  250. BEGIN                                  (* Z:=csin(A) *)
  251.     Z.RE:=Sin(A.RE)*Cosh(A.IM);
  252.     Z.IM:=Cos(A.RE)*Sinh(A.IM)
  253. END csin;    
  254.  
  255. (*-------------------------------------------------------------------------*)
  256. (*                                                                         *)
  257. (* PROCEDURE: carcsin                                                      *)
  258. (*                                                                         *)
  259. (* AUFGABE: komplexer Arkussinus                                           *)
  260. (*-------------------------------------------------------------------------*)
  261.  
  262. PROCEDURE carcsin (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  263. VAR 
  264.     B,C,D,E : FFPCOMPLEX;              (* Z:=carcsin(A) *)
  265. BEGIN
  266.     B.RE:=0.0; B.IM:=1.0;
  267.     C.RE:=1.0; C.IM:=0.0;
  268.     csqr(E,A); compop(D,C,'-',E); csqrt(D,D); compop(E,B,'*',A);
  269.     compop(D,D,'+',E); cln(E,D); compop(D,B,'*',E);
  270.     Z.RE:=-D.RE;
  271.     Z.IM:=-D.IM
  272. END carcsin;
  273.     
  274. (*-------------------------------------------------------------------------*)
  275. (*                                                                         *)
  276. (* PROCEDURE: ccos                                                         *)
  277. (*                                                                         *)
  278. (* AUFGABE: komplexer Kosinus                                              *)
  279. (*-------------------------------------------------------------------------*)
  280.  
  281. PROCEDURE ccos (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  282. BEGIN                                   (* Z:=ccos(A) *)
  283.     Z.RE:=Cos(A.RE)*Cosh(A.IM);
  284.     Z.IM:=-Sin(A.RE)*Sinh(A.IM)
  285. END ccos;        
  286.  
  287. (*-------------------------------------------------------------------------*)
  288. (*                                                                         *)
  289. (* PROCEDURE: carccos                                                      *)
  290. (*                                                                         *)
  291. (* AUFGABE: komplexer Arkuskosinus                                         *)
  292. (*-------------------------------------------------------------------------*)
  293.  
  294. PROCEDURE carccos (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  295. VAR 
  296.     B,C,D,E : FFPCOMPLEX;
  297. BEGIN                              (* Z:=carccos(A) *)
  298.     B.RE:=0.0; B.IM:=1.0;
  299.     C.RE:=1.0; C.IM:=0.0;
  300.     csqr(E,A); compop(D,E,'-',C); csqrt(D,D); compop(D,A,'+',D);
  301.     cln(E,D); compop(D,B,'*',E);
  302.     Z.RE:=-D.RE;
  303.     Z.IM:=-D.IM
  304. END carccos;
  305.  
  306. (*-------------------------------------------------------------------------*)
  307. (*                                                                         *)
  308. (* PROCEDURE: ctan                                                         *)
  309. (*                                                                         *)
  310. (* AUFGABE: komplexer Tangens                                              *)
  311. (*-------------------------------------------------------------------------*)
  312.  
  313. PROCEDURE ctan (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  314. VAR
  315.     X : FFP;
  316. BEGIN                                      (* Z:=ctan(A) *)
  317.     X:=Cos(2.0*A.RE)+Cosh(2.0*A.IM);
  318.     Z.RE:=Sin(2.0*A.RE)/X;
  319.     Z.IM:=Sinh(2.0*A.IM)/X
  320. END ctan;    
  321.  
  322. (*-------------------------------------------------------------------------*)
  323. (*                                                                         *)
  324. (* PROCEDURE: carctan                                                      *)
  325. (*                                                                         *)
  326. (* AUFGABE: komplexer Arkustangens                                         *)
  327. (*-------------------------------------------------------------------------*)
  328.  
  329. PROCEDURE carctan (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX);
  330. VAR 
  331.     B,C,D,E,F,U,V : FFPCOMPLEX;
  332. BEGIN                                   (* Z:=carctan(A) *)
  333.     B.RE:=0.0; B.IM:=1.0;
  334.     C.RE:=1.0; C.IM:=0.0;
  335.     F.RE:=0.0; F.IM:=-0.5;
  336.     compop(U,B,'*',A); 
  337.     compop(E,C,'-',U); compop(D,C,'+',U); compop(V,D,'/',E);
  338.     cln(E,V); compop(D,F,'*',E); 
  339.     Z.RE:=D.RE;
  340.     Z.IM:=D.IM
  341. END carctan;
  342.  
  343. (*-------------------------------------------------------------------------*)
  344. (*                                                                         *)
  345. (* PROCEDURE: csinh                                                        *)
  346. (*                                                                         *)
  347. (* AUFGABE: komplexer Hyperbelsinus                                        *)
  348. (*-------------------------------------------------------------------------*)
  349.  
  350. PROCEDURE csinh (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  351. BEGIN                                  (* Z:=csinh(A) *)
  352.     Z.RE:=Sinh(A.RE)*Cos(A.IM);
  353.     Z.IM:=Cosh(A.RE)*Sin(A.IM)
  354. END csinh;        
  355.  
  356. (*-------------------------------------------------------------------------*)
  357. (*                                                                         *)
  358. (* PROCEDURE: carsinh                                                      *)
  359. (*                                                                         *)
  360. (* AUFGABE: komplexer Areasinus                                            *)
  361. (*-------------------------------------------------------------------------*)
  362.  
  363. PROCEDURE carsinh (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  364. VAR 
  365.     B,C,D,E : FFPCOMPLEX;              (* Z:=carsinh(A) *)
  366. BEGIN
  367.     B.RE:=0.0; B.IM:=1.0;
  368.     C.RE:=1.0; C.IM:=0.0;
  369.     csqr(E,A); compop(D,C,'+',E); csqrt(D,D); compop(D,D,'+',A);
  370.     cln(D,D);
  371.     Z.RE:=D.RE;
  372.     Z.IM:=D.IM
  373. END carsinh;
  374.     
  375. (*-------------------------------------------------------------------------*)
  376. (*                                                                         *)
  377. (* PROCEDURE: ccosh                                                        *)
  378. (*                                                                         *)
  379. (* AUFGABE: komplexer Hyperbelkosinus                                      *)
  380. (*-------------------------------------------------------------------------*)
  381.  
  382. PROCEDURE ccosh (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  383. BEGIN                                      (* Z:=ccosh(A) *)
  384.     Z.RE:=Cosh(A.RE)*Cos(A.IM);
  385.     Z.IM:=Sinh(A.RE)*Sin(A.IM)
  386. END ccosh;        
  387.  
  388. (*-------------------------------------------------------------------------*)
  389. (*                                                                         *)
  390. (* PROCEDURE: carcosh                                                      *)
  391. (*                                                                         *)
  392. (* AUFGABE: komplexer Areakosinus                                          *)
  393. (*-------------------------------------------------------------------------*)
  394.  
  395. PROCEDURE carcosh (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  396. VAR 
  397.     B,C,D,E : FFPCOMPLEX;            (* Z:=carcosh(A) *)
  398. BEGIN
  399.     B.RE:=0.0; B.IM:=1.0;
  400.     C.RE:=1.0; C.IM:=0.0;
  401.     csqr(E,A); compop(D,E,'-',C); csqrt(D,D); compop(D,A,'+',D);
  402.     cln(D,D); 
  403.     Z.RE:=D.RE;
  404.     Z.IM:=D.IM
  405. END carcosh;
  406.  
  407. (*-------------------------------------------------------------------------*)
  408. (*                                                                         *)
  409. (* PROCEDURE: ctanh                                                        *)
  410. (*                                                                         *)
  411. (* AUFGABE: komplexer Hyperbeltangens                                      *)
  412. (*-------------------------------------------------------------------------*)
  413.  
  414. PROCEDURE ctanh (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX);
  415. VAR
  416.     X : FFP;                      (* Z:=ctanh(A) *)
  417. BEGIN
  418.     X:=Cosh(2.0*A.RE)+Cos(2.0*A.IM);
  419.     Z.RE:=Sinh(2.0*A.RE)/X;
  420.     Z.IM:=Sin(2.0*A.IM)/X
  421. END ctanh;        
  422.  
  423. (*-------------------------------------------------------------------------*)
  424. (*                                                                         *)
  425. (* PROCEDURE: cartanh                                                      *)
  426. (*                                                                         *)
  427. (* AUFGABE: komplexer Areatangens                                          *)
  428. (*-------------------------------------------------------------------------*)
  429.  
  430. PROCEDURE cartanh (VAR Z : FFPCOMPLEX; A : FFPCOMPLEX); 
  431. VAR 
  432.     C,D,E,V : FFPCOMPLEX;            (* Z:=cartanh(A) *)
  433. BEGIN
  434.     C.RE:=1.0; C.IM:=0.0;
  435.      compop(E,C,'-',A); compop(D,C,'+',A); compop(V,D,'/',E);
  436.     cln(D,V);  
  437.     Z.RE:=D.RE/2.0;
  438.     Z.IM:=D.IM/2.0
  439. END cartanh;
  440.  
  441. (*-------------------------------------------------------------------------*)
  442. (*                                                                         *)
  443. (* PROCEDURE: cpower                                                       *)
  444. (*                                                                         *)
  445. (* AUFGABE: komplexe Potenzfunktion                                        *)
  446. (*-------------------------------------------------------------------------*)
  447.  
  448. PROCEDURE cpower (VAR Z : FFPCOMPLEX; A,B : FFPCOMPLEX); 
  449.                   (* Z:=A^B *)
  450. VAR
  451.     X : FFPCOMPLEX;
  452. BEGIN
  453.     cln(X,A); compop(X,B,'*',X); cexp(Z,X)
  454. END cpower;
  455.  
  456. (*-------------------------------------------------------------------------*)
  457. (*                                                                         *)
  458. (* PROCEDURE: croot                                                        *)
  459. (*                                                                         *)
  460. (* AUFGABE: n-te komplexe Wurzel mit Haupt- und Nebenwerten                *)
  461. (*-------------------------------------------------------------------------*)
  462.  
  463. PROCEDURE croot (VAR Z:FFPCOMPLEX; K,N:FFP; A : FFPCOMPLEX); 
  464.         (* Z:=N-te Wurzel(A); mit Haupt- und Nebenwert K *)
  465. VAR
  466.     R,PHI,KONST : FFP;
  467. BEGIN
  468.     R:=root(N,cabs(A)); (* Betrag von A *)
  469.     PHI:=carg(A); (* Winkel von A im Bogenmaß *)
  470.     KONST:=(PHI+2.0*K*PI)/N;
  471.     Z.RE:=R*Cos(KONST);
  472.     Z.IM:=R*Sin(KONST)
  473. END croot;
  474.  
  475. END FFPComplexLib.
  476.